home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / glib19.zip / GLIBDEMO.BAS < prev    next >
BASIC Source File  |  1991-06-27  |  33KB  |  1,231 lines
  1. '
  2. ' GLIBDEMO version 3.5
  3. ' (C) Copyright 1987-1990, 1991
  4. '
  5. ' Demo of some of the newer, more useful or more interesting
  6. ' routines from GLIB version 1.9 for QuickBASIC 4.5
  7. '
  8. ' Written by Gizmo Mike
  9. '
  10. ' NOTE: This should have started from the batch file for proper
  11. '       switch settings.
  12. ' QB glibdemo /l glib19 /cmd <scrfile> <3 or 4 fake switches>
  13.  
  14. DECLARE FUNCTION AttrMake% (fg%, bg%)
  15. DECLARE FUNCTION ArgCnt%
  16. DECLARE FUNCTION ArgVar$ (x%)
  17. DECLARE FUNCTION MenuChoice% (menu$(), Trow%, LCol%, NAttr%, Hattr%, title$, Mark%(), XtdChc%)
  18. DECLARE FUNCTION DIR% (mask$, BYVAL FilArryPtr)
  19. DECLARE FUNCTION CPUInfo% (model%, submodel%, BiosRev%, cpu%, ndp%)
  20. DECLARE FUNCTION DayOfYr%
  21. DECLARE FUNCTION DialogBox$ (msg$, prompt$, ok$)
  22. DECLARE FUNCTION ExtMemFree%
  23. DECLARE FUNCTION ExtMemInst%
  24. DECLARE FUNCTION FUnique% (Fil$, attr%, handle%)
  25. DECLARE FUNCTION FClose% (handle%)
  26. DECLARE FUNCTION FCount% (mask$)
  27. DECLARE FUNCTION FReadArray% (SEG arry%, fhandle%, bytes%)
  28. DECLARE FUNCTION FExists% (Fil$)
  29. DECLARE FUNCTION FuncResp% ()
  30. DECLARE FUNCTION GetCh$ (ok$)
  31. DECLARE FUNCTION GetDrv% ()
  32. DECLARE FUNCTION GetCmdStr$
  33. DECLARE FUNCTION GetCmdTLen%
  34. DECLARE FUNCTION GetStack%
  35. DECLARE FUNCTION KeyReady%
  36. DECLARE FUNCTION LCount% (fhandle%, buffer$)
  37. DECLARE FUNCTION MenuCtrl% ()
  38. DECLARE FUNCTION MHz&
  39. DECLARE FUNCTION ParseFileSpec% (raw$, SEG FInfo AS ANY)
  40. DECLARE FUNCTION PrgName$
  41. DECLARE FUNCTION PtrStat% (x%)
  42. DECLARE FUNCTION SysTicks&
  43. DECLARE FUNCTION SubDirGet$
  44. DECLARE FUNCTION VidType% ()
  45. DECLARE FUNCTION VLabelGet$ (drv%)
  46. DECLARE FUNCTION VerifyGet% ()
  47.  
  48. DECLARE SUB SaveScrn (SEG arry%)
  49. DECLARE SUB RestScrn (SEG arry%)
  50. DECLARE SUB DirF (mask$, SEG FilArryPtr AS ANY)
  51. DECLARE SUB PrintStatL (SEG MsgArray AS ANY, action%, attr%)
  52.  
  53. CLEAR
  54. DEFINT A-Z
  55. OPTION BASE 1
  56.  
  57.     TYPE structf
  58.         drv AS STRING * 2
  59.         Path AS STRING * 64
  60.         Fil AS STRING * 8
  61.         Ext AS STRING * 3
  62.     END TYPE
  63.  
  64.     DIM FInfo AS structf                ' ParseFIle structure defined
  65.  
  66.  
  67.  
  68.     CLS
  69.     crt = VidType                       ' get type of display
  70.  
  71.     IF crt MOD 2 = 0 THEN               ' set colors based on CRT Type
  72.         fg = 7                          ' EGA mono, Mono, or VGA mono
  73.         fgh = 15                        ' use bland colors
  74.         fgw = 0
  75.         bgw = 7
  76.         NAttr = 112
  77.         Rattr = 7
  78.         cmode = 0
  79.     ELSE
  80.         fg = 3                     ' CGA, EGA or VGA
  81.         fgh = 14                   ' use less bland colors
  82.         fgw = 14
  83.         bgw = 4
  84.         NAttr = 78
  85.         Rattr = 14
  86.         cmode = 1
  87.     END IF
  88.     COLOR fg, 0
  89.  
  90.     TYPE struct                         ' type structure for DirF
  91.         s AS STRING * 12
  92.     END TYPE
  93.  
  94.     TYPE structa
  95.         ls AS STRING * 80
  96.     END TYPE
  97.  
  98.     REDIM menu$(28)                     ' string array of demo choices
  99.     REDIM Mark(28)                      ' allow marking of up to 5
  100.  
  101.     REDIM TSqMsg$(4)                    ' TimeSquare msgs
  102.     TSqMsg$(1) = "Press any key to continue"
  103.     TSqMsg$(2) = "GLIB: The standard in QB Libraries"
  104.     TSqMsg$(3) = "This is a demo of TimeSquare"
  105.     TSqMsg$(2) = "GLIB: So much Power, so few $$$"
  106.  
  107.     'set up status line messages
  108.     REDIM SLine(2) AS structa
  109.     SLine(1).ls = "               Navigate with Cursor keys.   Select with [Enter]  "
  110.     SLine(2).ls = "    Mark up to 5 selections with [TAB] or [SpaceBar].    [Esc] Quits Demo"
  111.  
  112.  
  113.  
  114.     REDIM ScrText((7 * 2000) + 1)       ' up to 5 info screens
  115.  
  116.     REDIM ScrnArry(12001)               ' enough for 6 screens
  117.  
  118.     REDIM temp(10)                      ' for printing GLIB returns in a loop
  119.  
  120.     NumArgs = ArgCnt                    ' call Argument Count function
  121.  
  122.     IF (NumArgs = 0) OR (FExists(Arg$(1)) = 0) THEN
  123.         ScrFil$ = "ScrLib19.DAT"
  124.         IF FExists(ScrFil$) = 0 THEN
  125.             GOSUB HowToRunDemo
  126.             SYSTEM
  127.         END IF
  128.     ELSE
  129.         ScrFil$ = ArgVar$(5)
  130.         ScrNum = 0                      ' screen to load
  131.     END IF
  132.  
  133.     ' the demo selections
  134.     DATA Other InfoSoft Items, Boxes, Chirp, ArgCnt/ArgVar/GetCmdTail, Date / DFRMAT, DIR
  135.     DATA DrvSpace, DayOfYr, DialogBox, FExists/FileDNE, FlexMenu, FUnique
  136.     DATA GetCH/PGetCh, LCount, MenuCtrl/FuncResp, PrgName/Parse, Printer Routines (4)
  137.     DATA Painter, QPrint, Equip Info Routines, "Scrolling (U/D, L/R)"
  138.     DATA TFrmat/Systime, Save/Rest Scrn, Windows, VidON / VidOFF
  139.     DATA Read / Write Array, Read / Write String, QUIT Demo (or [Esc])
  140.  
  141.     FOR x = 1 TO 28                     ' build the main menu
  142.         READ menu$(x)
  143.     NEXT x
  144.  
  145.     FOR x = 1 TO 3
  146.         ScrNum = x                      ' set screen to load
  147.         ScrPOS = ((x - 1) * 2000) + 1   ' array position to load to
  148.         GOSUB LoadScrn
  149.     NEXT x
  150.  
  151.     FOR x = 1 TO 3
  152.         ScrOffs = ((x - 1) * 2000) + 1  ' set offset pointer to array
  153.         CALL RestScrn(ScrText(ScrOffs)) ' display screen
  154.         x$ = INPUT$(1)                  ' eat key press
  155.     NEXT x
  156.  
  157.     title$ = " GLIB Demo "              ' FlexMenu title
  158.     First = LBOUND(menu$)               ' first possible selection
  159.     Last = UBOUND(menu$)                ' last (in case somebody messes with it)
  160.  
  161.  
  162.     DO
  163.         CLS
  164.         MarkedItem = 0                  ' reset flags
  165.         ArrayPOS = 0
  166.         XtdChc = 5                      ' how many marks to allow
  167.         REDIM Mark(Last)                ' erase old marks
  168.  
  169.         CALL PrintStatL(SLine(1), 0, 112)
  170.  
  171.         item = MenuChoice%(menu$(), -1, -1, NAttr%, Rattr%, title$, Mark%(), XtdChc%)
  172.  
  173.         IF XtdChc <> 27 THEN
  174.             FOR i = First TO Last       ' check for marked items
  175.                 IF Mark(i) THEN
  176.  
  177.                     item = i
  178.                     MarkedItem = 1
  179.                     IF (item < Last + 1) THEN
  180.                         GOSUB ExecItem
  181.                     END IF
  182.  
  183.                 END IF
  184.             NEXT i
  185.  
  186.             IF MarkedItem = 0 THEN
  187.                 GOSUB ExecItem
  188.             END IF
  189.         END IF
  190.  
  191.     LOOP UNTIL (XtdChc = 27) OR (item = Last + 1)
  192.  
  193.     ' closing sequence
  194.     CLS
  195.  
  196.     ScrNum = 1                     ' set screen to load
  197.     ScrPOS = 1
  198.     GOSUB LoadScrn
  199.     CALL RestScrn(ScrText(1))
  200.  
  201.     msg$(1) = " Place your GLIB order now!  "          ' change final msgs
  202.     msg$(3) = " Place your GLIB order now!  "
  203.     LOCATE 24, 3
  204.     PRINT SPACE$(60);
  205.  
  206.     CALL TimeSquare(msg$(), 24, 23, NAttr, 0)
  207.  
  208.     LOCATE 24, 3
  209.     PRINT SPACE$(60);
  210.     LOCATE 23, 1
  211.  
  212. SYSTEM
  213.  
  214. ExecItem:
  215.     IF item > 20 THEN item = item + 1
  216.  
  217.     CLS
  218.  
  219.     DoFade = 0
  220.  
  221.     ScrNum = item + 3                   ' adjust for logo etc
  222.     ScrPOS = 1                          ' adjust for OTHER INFO
  223.     GOSUB LoadScrn
  224.  
  225.     'IF item <> 23 THEN
  226.     CALL RestScrn(ScrText(ScrPOS))
  227.     'END IF
  228.  
  229.     SELECT CASE item
  230.         CASE 0, 1, 11
  231.  
  232.         CASE 2
  233.             x$ = INPUT$(1)
  234.             GOSUB BoxDemo
  235.  
  236.         CASE 3
  237.             GOSUB ChirpDemo
  238.  
  239.         CASE 4
  240.             GOSUB CmdLDemo
  241.  
  242.         CASE 5
  243.             GOSUB DateStuff
  244.  
  245.         CASE 6
  246.             x$ = INPUT$(1)
  247.             GOSUB DirDemo
  248.  
  249.         CASE 7
  250.             GOSUB DrvSpaceDemo
  251.  
  252.         CASE 8
  253.             GOSUB DayYrDemo
  254.  
  255.         CASE 9
  256.             x$ = INPUT$(1)
  257.             GOSUB DialogBoxDemo
  258.  
  259.         CASE 10
  260.             GOSUB ExistDemo
  261.  
  262.         CASE 12
  263.             GOSUB UniqDemo
  264.  
  265.         CASE 13
  266.             GOSUB GetChDemo
  267.     
  268.         CASE 14
  269.             GOSUB LCountDemo
  270.  
  271.         CASE 15
  272.             GOSUB MenuCtrlDemo
  273.  
  274.         CASE 16
  275.             GOSUB PrgNameDemo
  276.  
  277.         CASE 17
  278.             GOSUB PtrDemo
  279.  
  280.         CASE 18
  281.             x$ = INPUT$(1)
  282.             GOSUB PaintDemo
  283.  
  284.         CASE 19
  285.             x$ = INPUT$(1)
  286.             GOSUB QPrintDemo
  287.  
  288.         CASE 20
  289.             speed = MHz& / 100       ' do test while reading screen
  290.             x$ = INPUT$(1)
  291.             ScrNum = ScrNum + 1     ' adjust for logo etc
  292.             ScrPOS = 2              ' adjust for OTHER INFO
  293.             GOSUB LoadScr